home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu358.dms / pu358.adf / DonsGenies / Don'sGenies / MakePieChart.pprx < prev    next >
Text File  |  1992-07-16  |  5KB  |  193 lines
  1. /* This Genie draws Pie Charts. You must have gdarexxsupport.library in your libs: directory (normally installed with PPage 3).
  2. Written by Don Cox  May '92  */
  3.  
  4.  
  5.  
  6. cr = '0a'x
  7. call SafeEndEdit.rexx()
  8. call ppm_AutoUpdate(0)
  9. call ppm_NewGroup()
  10.  
  11.  
  12. if ~show("l", "gdarexxsupport.library") then
  13.     if ~addlib("gdarexxsupport.library", 0, -30,0) then
  14.     do
  15.         call ppm_Inform(1,"Please install the gdarexxsupport.library in your libs: directory before running this Genie.")
  16.     end
  17.  
  18. units = ppm_GetUnits()
  19. call ppm_SetUnits(2)
  20.  
  21. signal on halt
  22. signal on break_c
  23. signal on break_e
  24. signal on break_d
  25.  
  26. box = ppm_ClickOnBox("Click on box to make chart..")
  27.  
  28. if box = 0 then
  29. do
  30.     call ppm_Inform(1, "No box selected",)
  31.     call ppm_ClearStatus()
  32.     exit
  33. end
  34.  
  35. /*  extract box attributes  */
  36. boxsize = ppm_GetBoxSize(box)
  37. boxpos = ppm_GetBoxPosition(box)
  38.  
  39. if ppm_Inform(2, "Delete box?",) = 1 then call ppm_DeleteBox(box)
  40.  
  41. boxwidth = word(boxsize, 1)
  42. boxheight = word(boxsize, 2)
  43. boxleft = word(boxpos, 1)
  44. boxtop = word(boxpos, 2)
  45. Xcentre = boxleft+(boxwidth/2)
  46. Ycentre = boxtop+(boxheight/2)
  47.  
  48. if boxwidth>boxheight then radius = boxheight*0.36
  49. else radius = boxwidth*0.3 /* allow room for labels */
  50.  
  51. nmsegs = GetUserText(4, "Number of Segments")
  52. if nmsegs > 18 then exit_msg("Max number of segments is 18")
  53.  
  54. form = ' Segment 1'
  55. do x = 2 while x <= nmsegs
  56.  form = form cr 'Segment' x
  57. end
  58.  
  59.  
  60. form = ppm_GetForm("Type in Percentages",6,form)
  61. if form = "" then exit_msg("Operation Cancelled")
  62.  
  63. x = 1
  64. do forever
  65.     parse var form bdata.x '0a'x form
  66.     if bdata.x = "" then leave
  67.     cdata.x = bdata.x * 3.6   /* convert %ages to degrees */
  68.     x = x + 1
  69. end
  70.  
  71. form = ' Segment label 1'
  72. do x = 2 while x <= nmsegs
  73.    form = form cr 'Segment label' x
  74. end
  75.  
  76. form = ppm_GetForm("Labels for Segments",12,form)
  77. if form = "" then exit_msg("Operation Cancelled")
  78.  
  79. x = 1
  80. do forever
  81.    parse var form blabel.x '0a'x form
  82.    if blabel.x = "" then leave
  83.    x = x + 1
  84. end
  85. call ppm_SetLineWeight(1) /* 1-point lines */
  86. facelist = ppm_GetTypeFaceList()
  87. facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
  88. face = ppm_SelectFromList("Select Typeface",32,18,0,facelist)
  89.  
  90.  
  91. oldface = ppm_GetFont()
  92. oldsize = ppm_GetSize()
  93. oldstyle = ppm_GetStyle()
  94. oldjust = ppm_GetJustification()
  95. call ppm_SetJustification(2)
  96. call ppm_SetFont(face)
  97. call ppm_SetSize(radius*3)  /* size in points */
  98. call ppm_SetStyle(N)
  99.  
  100. startangle=0
  101. do i=1 to nmsegs
  102.     call ppm_ShowStatus("Working on segment:" i)
  103.     angle=cdata.i
  104.     call ppm_SetFillPattern(i//9) /* use modulo to cycle through the available patterns */
  105.     boxname=blabel.i
  106.     data = bdata.i
  107.     endangle = startangle+angle
  108.     manylines = Xcentre "0a"x Ycentre "0a"x radius "0a"x startangle "0a"x endangle "0a"x boxname "0a"x data
  109.     call drawsector(manylines)
  110.     startangle = endangle
  111.     end
  112.  
  113. call ppm_SetFont(oldface)
  114. call ppm_SetSize(oldsize)
  115. call ppm_SetStyle(oldstyle)
  116. call ppm_SetJustification(oldjust)
  117. exit_msg("Done")
  118. end
  119.  
  120. /* -------------------------------------------------------------------- */
  121.  
  122. /* Procedure to draw a sector for a pie chart */
  123.  
  124. drawsector: procedure
  125.  
  126. parse arg Xcentre "0a"x Ycentre "0a"x radius "0a"x startangle "0a"x endangle "0a"x boxname "0a"x data
  127. AA=6.2831853/360    /* 2pi divided by 360 */
  128.  
  129. drawstring = Xcentre Ycentre"0a"x  /* List all the points, beginning at the centre */
  130.  
  131. if startangle>endangle then
  132.     do
  133.     xx=startangle
  134.     startangle=endangle
  135.     endangle=xx
  136.     end
  137. if startangle=endangle then return
  138.  
  139. angle=startangle*AA /* convert to radians */
  140. arcsize = endangle-startangle 
  141. radarcsize = arcsize*AA /* convert to radians */
  142.  
  143. /* Set up values for label box before "angle" gets changed */
  144. labelXradius = radius*1.5
  145. labelYradius = radius*1.25
  146. labelboxheight = radius/4
  147. labelboxwidth = radius*1
  148. labelangle = angle+(radarcsize/2)
  149. labelleft = Xcentre+(labelXradius*cos(labelangle))-(radius/2)
  150. labeltop = Ycentre+(labelYradius*sin(labelangle))-(radius/9)
  151.  
  152. /* Draw the segment itself, in 1 degree steps to give a smooth curve */
  153. do i = 0 to arcsize
  154.     X2=Xcentre+(radius*cos(angle))
  155.     Y2=Ycentre+(radius*sin(angle))
  156.     angle=angle+AA
  157.     drawstring=drawstring||X2 Y2"0a"x
  158.     end
  159. drawstring = drawstring||Xcentre Ycentre"0a"x
  160. call ppm_SaveText("ram:arcdata",drawstring)
  161.  
  162. box = ppm_DrawPoly("ram:arcdata",boxname)
  163.  
  164. /* Now draw the box for the label */
  165. labelbox = ppm_CreateBox(labelleft, labeltop, labelboxwidth, labelboxheight, 0)
  166. overflow = ppm_TextIntoBox(labelbox,boxname "0a"x data||"%")
  167.  
  168. return
  169. end
  170.  
  171. /* --------------------------------------------------------------- */
  172.  
  173. /* Exit Routines */
  174. break_d:
  175. break_e:
  176. break_c:
  177. halt:
  178.     call exit_msg("User aborted Genie!")
  179.  
  180. error:
  181. syntax:
  182.     do exit_msg("Genie failed due to error: "errortext(rc))
  183.     end
  184.  
  185. exit_msg:
  186.     do
  187.     parse arg message
  188.     if message ~= "" then call ppm_Inform(1,message,"Resume")
  189.     call ppm_ClearStatus()
  190.     call ppm_AutoUpdate(1)
  191.     exit
  192.     end
  193.